home *** CD-ROM | disk | FTP | other *** search
/ The PC-SIG Library 9 / The PC-SIG Library on CD ROM - Ninth Edition.iso / 1501_600 / DISK1524 / DISK1524.ZIP / SPROGH.BAS < prev    next >
BASIC Source File  |  1989-06-08  |  37KB  |  1,106 lines
  1. '
  2. ' SPROGH:A SPIROGRAPH SIMULATOR BY PHIL PAUSTIAN
  3. '
  4. '       VERSION 3.2
  5. '       COPYRIGHT 1989
  6. '
  7. ' PROGRAM INDEX                STARTS ON LINE
  8. '    INTRODUCTORY SCREEN...................40
  9. '    DRAW INITIAL MENU....................120
  10. '    SET MENU.............................142
  11. '    COMMAND CHOOSING.....................177
  12. '    SET DISK GEARS.......................185
  13. '    SET RING GEARS.......................210
  14. '    SET PEN POSITION.....................235
  15. '    MOVE.................................250
  16. '    SIZE.................................300
  17. '    TURN.................................340
  18. '    OVAL.................................350
  19. '    HUE (LINE COLOR).....................360
  20. '    WIPE (PAINT FILL)....................370
  21. '    FORM (GEARS OR DEGREES)..............430
  22. '    LOAD/SAVE............................440
  23. '    INITIALIZE (RESET VARIABLES).........515
  24. '    VERSION..............................525
  25. '    EXAMPLES.............................550
  26. '    AGAIN (MACRO COMMANDS)...............582
  27. '    BLANK MENU...........................610
  28. '    CLEAR SCREEN.........................615
  29. '    GO  (DRAW DESIGN)....................620
  30. '    QUIT.................................705
  31. '    ERROR TRAPPPING (FILE INPUT).........750
  32. '    LOGO.................................787
  33. '    NUMBER INPUT SUBROUTINE..............820
  34. '    WORD INPUT SUBROUTINE................885
  35. '    MACRO INPUT (AGAIN COMMAND)..........932
  36. '    WIPE: COLOR CHANGES SUBROUTINE.......940
  37. '    TILE PATTERNS........................992
  38. '    END.................................1106
  39.  
  40. '    Intro Screen
  41. ' INITIALIZE VARIABLES AND DRAW SAMPLE IMAGE
  42. $STACK &H4000
  43. SCREEN 2:KEY OFF:CLS
  44. WINDOW SCREEN (-150,-100)-(150,110)
  45. PI=ATN(1)/45:DSKANGL=-12*PI:RNGANGL=9.5*PI
  46. GDTOGL%=1:PENINPUT=.55:CIR=360*PI:REP%=1
  47. SIZOPT%=0:SIZOPT$="auto "
  48. OVALNESS=1.7:ROTAT=0:MOVHORIZ=0
  49. MOVVERT=0:SIZ=1.25:HUE%=1:ZERO=.01:WD=4:HG=8.4
  50. DIM WNDW%(3500), BLANKLINE%(1000), MENUWNDW%(3500), TILER%(5)
  51. DIM REFRESHA%(15000), CROSSHAIRS%(100), TILE$(150)
  52. GET (-150,102)-(150,110),BLANKLINE%
  53. SEE$=COMMAND$:IF SEE$<>"" THEN GOTO SCRENE
  54.  
  55. INTROSCREEN:
  56. GET (-150,-100)-(150,100),REFRESHA%
  57. CLS:STOG=ABS(STOG-1)
  58. LINE (-148,-98)-(146,99),,B
  59. LINE (-146,-100)-(148,97),,B
  60. IF STOG=1 THEN S1=5.3:S2=-55:S3=12:S4=-34 ELSE S1=4:S2=-40:S3=8:S4=-24
  61. GOSUB LOGO
  62.  
  63. LOCATE 23,3:PRINT "by Phil Paustian"
  64. LOCATE 23,55:PRINT "Press any key to begin";
  65. GET (-150,-100)-(14*WD-146,24*HG-100),WNDW%
  66.  
  67. '   DRAW TWO SAMPLE DESIGNS
  68. DSKANGL=-DSKANGL:PENINPUT=ABS(PENINPUT-1.4):KY$="G":GOTO SET
  69.  
  70. SCRENE:
  71. '   INPUT SCREEN TYPE
  72. DEF SEG=&H40:SCRNTYPE=PEEK(&H10) AND 48
  73. IF SCRNTYPE=48 THEN
  74.    SCREEN 2: FILESIZ=40000:DEF SEG=&HB000:EXT$=".HRC":LINELENGTH%=76
  75. ELSE
  76.    IF SEE$<>"" THEN
  77.      SCRN$=MID$(SEE$,LEN(SEE$)-3,2)
  78.      IF SCRN$=".C" OR SCRN$=".M" THEN SCRN$=RIGHT$(SCRN$,1):GOTO 1
  79.    END IF
  80.    LOCATE 23,55:PRINT "(C)olor or (M)onochrome?";
  81.    WHILE NOT INSTAT:WEND:KK$=INKEY$
  82.    SCRN$=UCASE$(KK$):IF SCRN$<>"C" AND SCRN$<>"M" THEN GOTO SCRENE
  83. 1  IF SCRN$="C" THEN
  84.        SCREEN 1,0:FILESIZ=16384
  85.        DEF SEG=&HB800:EXT$=".COL":WD=7:LINELENGTH%=36
  86.    ELSE
  87.        SCREEN 2:FILESIZ=16384
  88.        DEF SEG=&HB800:EXT$=".MON":LINELENGTH%=76
  89.    END IF
  90. END IF
  91. WINDOW SCREEN (-150,-100)-(150,110):CLS
  92. GET (-150,102)-(150,110),BLANKLINE%
  93. GET (-150,-100)-(14*WD-146,24*HG-100),WNDW%
  94. IF SCRN$="C" THEN
  95.  GET (-150,-100)-(150,100),REFRESHA%
  96. END IF
  97. ' DRAW CROSSHAIRS FOR USE IN MOVING THE CENTER OF THE DESIGN
  98. LINE (-148,-93)-(-138,-93):LINE (-143,-98)-(-143,-88)
  99. CIRCLE (-143,-93),5
  100. GET (-150,-100)-(-137,-87),CROSSHAIRS%:PUT (-150,-100),CROSSHAIRS%
  101. IF SEE$<>"" THEN
  102.  FIL$=SEE$
  103.  GOSUB FILEXIST
  104.  IF FILECONTINUE=1 THEN
  105.   BLOAD SEE$,0
  106.   GET (-150,-100)-(150,100),REFRESHA%
  107.   GET (-150,-100)-(14*WD-146,24*HG-100),WNDW%
  108.   WHILE NOT INSTAT:WEND:KK$=INKEY$
  109.   PUT (-150,-100),WNDW%
  110.  END IF
  111.   PUT (-150,102),BLANKLINE%,PSET
  112. END IF
  113. '    REINITIALIZE VARIABLES
  114. LOCATED$="":SIZ=1:PENPOS=1:RATIO=1:SAMPLE%=0:SAMPL%=0:REP%=0
  115. IF SEE$="" THEN FIL$="SPIRO1"+EXT$
  116. OVALNESS=1:DSKANGL=0:RNGANGL=0:MENU%=1:PENINPUT=1
  117.  
  118. LOCATE 25,1:PRINT "Hit Command Letter:";
  119.  
  120. '    PRINTING THE MENU
  121. LINE (-150,-100)-(14*WD-150,24*HG-104),,B
  122. LINE (-148,-98)-(14*WD-148,24*HG-102),,B
  123. LOCATE 2,2:PRINT "Disk"
  124. LOCATE 4,2:PRINT "Ring"
  125. LOCATE 6,2:PRINT "Pen position"
  126. LOCATE 8,2:PRINT "Move center"
  127. LOCATE 10,2:PRINT "Size:"
  128. LOCATE 12,2:PRINT "Turn:"
  129. LOCATE 13,2:PRINT "Oval:"
  130. LOCATE 14,2:PRINT "Hue:"
  131. LOCATE 15,2:PRINT "Form:"
  132. LOCATE 16,2:PRINT "Again"
  133. LOCATE 17,2:PRINT "Wipe"
  134. LOCATE 18,2:PRINT "Load/save"
  135. LOCATE 19,2:PRINT "Examples"
  136. LOCATE 20,2:PRINT "Blank menu"
  137. LOCATE 21,2:PRINT "Clear screen"
  138. LOCATE 22,2:PRINT "Go"
  139. LOCATE 23,2:PRINT "Quit";
  140. GET (-150,-100)-(14*WD-146,24*HG-100),MENUWNDW%
  141.  
  142. STARTING:
  143. IF MENU%=1 THEN
  144.   PUT (-150,-100),MENUWNDW%,PSET
  145.   IF GDTOGL%=1 THEN
  146.     LOCATE 2,7:PRINT "gears"
  147.     LOCATE 3,3:PRINT FIX((DSKGR+.001*SGN(DSKGR))*100)/100
  148.     LOCATE 4,7:PRINT "gears"
  149.     LOCATE 5,3:PRINT FIX((RNGGEAR+.001*SGN(RNGGEAR))*100)/100
  150.   ELSE
  151.     RATIO=1
  152.     LOCATE 2,7:PRINT "degrees"
  153.     LOCATE 3,3:PRINT FIX((DSKDEG+.001*SGN(DSKDEG))*100)/100
  154.     LOCATE 4,7:PRINT "degrees"
  155.     LOCATE 5,3:PRINT FIX((RNGDEG+.001*SGN(RNGDEG))*100)/100
  156.   END IF
  157.     LOCATE 7,3:PRINT FIX((PENINPUT+.001*SGN(PENINPUT))*100)/100
  158.     LOCATE 9,4:PRINT LOCATED$
  159.     IF GDTOGL%=1 THEN
  160.       IF DSKANGL*RNGANGL<>0 THEN RATIO=DSKANGL/RNGANGL
  161.       IF RATIO<>-1 THEN PENPOS=PENINPUT/(RATIO+1)*RATIO ELSE PENPOS=-PENINPUT
  162.     ELSE
  163.       RATIO=1:PENPOS=PENINPUT
  164.     END IF
  165.    LOCATE 10,7:PRINT SIZOPT$
  166.    LOCATE 11,3:PRINT FIX((SIZ+.001*SGN(SIZ))*100)/100
  167.    LOCATE 12,7:PRINT FIX((ROTAT+.001*SGN(ROTAT))*100)/100
  168.    LOCATE 13,7:PRINT FIX((OVALNESS+.001*SGN(OVALNESS))*100)/100
  169.    LOCATE 14,6:PRINT INT(HUE%)
  170.    IF GDTOGL%=0 THEN
  171.     LOCATE 15,7:PRINT "degrees"
  172.    ELSE
  173.     LOCATE 15,7:PRINT "gears"
  174.    END IF
  175. END IF
  176.  
  177. '   SEND THE PROGRAM TO THE APPROPRIATE ROUTINE
  178. WHILE NOT INSTAT:WEND
  179. KY$=UCASE$(INKEY$)
  180. SET:
  181. KOUT$=INKEY$
  182. IF KOUT$=CHR$(27) THEN REP%=0:GOTO STARTING
  183. SELECT CASE KY$
  184.  
  185. CASE ="D"
  186. '      DISK SUBROUTINE
  187. ' THIS MUST BE SET TO ANY NUMBER EXCEPT 0 BEFORE YOU CAN DRAW A DESIGN.
  188. ' SEE THE 'EXAMPLES' COMMAND FOR SOME POSSIBLE SETTINGS.  SEE THE 'FORM'
  189. ' COMMAND FOR THE DIFFERENCES BETWEEN INPUTTING  BY 'DISK GEARS' AND
  190. ' INPUTTING BY 'DISK DEGREES.'
  191.  IF GDTOGL%=1 THEN
  192.     PROMP$="Disk gears ["+STR$(FIX((DSKGR+.001*SGN(DSKGR))*100)/100)+"]: "
  193.     DEFAU$=STR$(DSKGR):GOSUB INNUM
  194.     IF ABORT%=1 THEN GOTO STARTING
  195.     IF PLUS%=1 THEN ASKNUM=ASKNUM+DSKGR
  196.     IF ASKNUM<>0 THEN DSKGR=ASKNUM:DSKDEG=360/DSKGR:DSKANGL=-DSKDEG*PI
  197.  ELSE
  198.     PROMP$="Disk degrees ["+STR$(FIX((DSKDEG+.001*SGN(DSKDEG))*100)/100)+"]: "
  199.     DEFAU$=STR$(DSKDEG)
  200.     GOSUB INNUM
  201.     IF ABORT%=1 THEN GOTO STARTING
  202.     IF PLUS%=1 THEN ASKNUM=ASKNUM+DSKDEG
  203.     IF ASKNUM<>0 AND ABS(ASKNUM)<32768 THEN
  204.      IF ASKNUM=>360 THEN ASKNUM=(ASKNUM/360-INT(ASKNUM/360))*360
  205.      IF ASKNUM<>0 THEN DSKDEG=ASKNUM
  206.      DSKGR=360/DSKDEG:DSKANGL=DSKDEG*PI
  207.     END IF
  208.  END IF
  209.  
  210. CASE ="R"
  211. '      RING SUBROUTINE
  212. ' THIS MUST BE SET AT ANY NUMBER OTHER THAN 0 BEFORE YOU CAN DRAW A DESIGN
  213. ' SEE THE 'FORM' COMMAND FOR THE DIFFERENCES BETWEEN INPUT BY GEARS AND
  214. ' INPUT BY DEGREES
  215.  IF GDTOGL%=1 THEN
  216.    PROMP$="Ring gears ["+STR$(FIX((RNGGEAR+.001*SGN(RNGGEAR))*100)/100)+"]: "
  217.    DEFAU$=STR$(RNGGEAR)
  218.    GOSUB INNUM
  219.    IF ABORT%=1 THEN GOTO STARTING
  220.    IF PLUS%=1 THEN ASKNUM=ASKNUM+RNGGEAR
  221.    IF ASKNUM<>0 THEN RNGGEAR=ASKNUM:RNGDEG=360/RNGGEAR:RNGANGL=RNGDEG*PI
  222.  ELSE
  223.    PROMP$="Ring degrees ["+STR$(FIX((RNGDEG+.001*SGN(RNGDEG))*100)/100)+"]: "
  224.    DEFAU$=STR$(RNGDEG)
  225.    GOSUB INNUM
  226.    IF ABORT%=1 THEN GOTO STARTING
  227.    IF PLUS%=1 THEN ASKNUM=ASKNUM+RNGDEG
  228.    IF ASKNUM<>0 AND ABS(ASKNUM)<32768 THEN
  229.     IF ASKNUM=>360 THEN ASKNUM=(ASKNUM/360-INT(ASKNUM/360))*360
  230.     IF ASKNUM<>0 THEN RNGDEG=ASKNUM
  231.     RNGGEAR=360/RNGDEG:RNGANGL=RNGDEG*PI
  232.    END IF
  233.  END IF
  234.  
  235. CASE ="P"
  236. '      PEN POSITION SUBROUTINE
  237. ' WHEN PENINPUT IS 0 THE PEN SITS AT THE CENTER OF THE DISK.  WHEN PEN IS
  238. ' SET AT 1 THE PEN SITS AT THE EDGE OF THE DISK.  YOU CAN SET THE PEN
  239. ' ANYWHERE BETWEEN THOSE TWO POINTS, OR EVEN SET IT OUTSIDE THE DISK WITH
  240. ' NUMBERS GREATER THAN 1
  241.  PROMP$="Pen position ["+STR$(FIX((PENINPUT+.001*SGN(PENINPUT))*100)/100)+"]: "
  242.  DEFAU$=STR$(PENINPUT)
  243.  GOSUB INNUM
  244.  IF ABORT%=1 THEN GOTO STARTING
  245.  IF PLUS%=1 THEN ASKNUM=ASKNUM+PENINPUT
  246.  PENINPUT=ASKNUM
  247.  
  248.  
  249.  
  250. CASE ="M"
  251. '      MOVE SUBROUTINE
  252.  PUT (-150,-100),WNDW%,PSET
  253.  IF REP%=0 THEN PUT (MOVHORIZ-7,MOVVERT-7),CROSSHAIRS%
  254.  PROMP$=LOCATED$+":Move (U,D,L,R)? "
  255.  DEFAU$=""
  256.  CHOIC$="UDLR"
  257.  GOSUB INWORD
  258.  IF ABORT%=1 THEN
  259.    IF REP%=0 THEN PUT (MOVHORIZ-7,MOVVERT-7),CROSSHAIRS%
  260.    GOTO STARTING
  261.  END IF
  262.  PROMP$=""
  263.  SELECT CASE ASKWRD$
  264.         CASE ="U"
  265.         PROMP$="up"
  266.         CASE ="D"
  267.         PROMP$="down"
  268.         CASE ="L"
  269.         PROMP$="left"
  270.         CASE ="R"
  271.         PROMP$="right"
  272.  END SELECT
  273.  IF PROMP$="" THEN
  274.   IF REP%=0 THEN PUT (MOVHORIZ-7,MOVVERT-7),CROSSHAIRS%
  275.   GOTO STARTING
  276.  END IF
  277.  PROMP$=LOCATED$+":How far? ("+PROMP$+") "
  278.  DEFAU$=""
  279.  GOSUB INNUM
  280.  IF REP%=0 THEN PUT (MOVHORIZ-7,MOVVERT-7),CROSSHAIRS%
  281.  IF ABORT%=1 THEN GOTO STARTING
  282.  SELECT CASE ASKWRD$
  283.         CASE ="U"
  284.          IF ABS(MOVVERT-ASKNUM)<91 THEN MOVVERT=MOVVERT-ASKNUM
  285.         CASE ="D"
  286.      IF ABS(MOVVERT+ASKNUM)<91 THEN MOVVERT=MOVVERT+ASKNUM
  287.         CASE ="L"
  288.          IF ABS(MOVHORIZ-ASKNUM)<141 THEN MOVHORIZ=MOVHORIZ-ASKNUM
  289.         CASE ="R"
  290.          IF ABS(MOVHORIZ+ASKNUM)<141 THEN MOVHORIZ=MOVHORIZ+ASKNUM
  291.  END SELECT
  292.  IF REP%=0 THEN PUT (MOVHORIZ-7,MOVVERT-7),CROSSHAIRS%
  293.  LOCATED$=""
  294.  IF MOVVERT<0 THEN LOCATED$="U"+STR$(ABS(MOVVERT))+" "
  295.  IF MOVVERT>0 THEN LOCATED$="D"+STR$(MOVVERT)+" "
  296.  IF MOVHORIZ<0 THEN LOCATED$=LOCATED$+"L"+STR$(ABS(MOVHORIZ))+" "
  297.  IF MOVHORIZ>0 THEN LOCATED$=LOCATED$+"R"+STR$(MOVHORIZ)+" "
  298.  IF REP%=0 THEN DELAY 1:PUT (MOVHORIZ-7,MOVVERT-7),CROSSHAIRS%
  299.  
  300. CASE ="S"
  301. '      SIZE SUBROUTINE
  302. ' "AUTO" CALCULATES SIZE AUTOMATICALLY ACCORDING TO THE SCALE SET BY 'SIZ'
  303. ' "FIXED" FIXES THE RING AT ITS CURRENT POSITION ON THE SCREEN SO THAT ALL
  304. '   SUBSEQUENT DRAWINGS WILL BE SCALED TO FIT AROUND IT
  305. ' "NESTED" DETERMINES THE SIZE OF THE HOLE IN THE MIDDLE OF THE SCREEN AND
  306. '   ADJUSTS 'SIZ' TO FIT SUBSEQUENT DRAWINGS INSIDE
  307. '   NESTED RESETS TO THE "AUTO" SETTING
  308.   PROMP$="Auto, Fixed or Nested ["+SIZOPT$+"]:"
  309.   CHOIC$="AFN"
  310.   DEFAU$=""
  311.   GOSUB INWORD
  312.   IF ABORT%=1 THEN GOTO STARTING
  313.   SELECT CASE ASKWRD$
  314.    CASE ="A"
  315.     SIZOPT%=0:SIZOPT$="auto "
  316.     PROMP$="Size ["+STR$(FIX((SIZ+.001*SGN(SIZ))*100)/100)+"]:"
  317.     DEFAU$=STR$(SIZ)
  318.     GOSUB INNUM
  319.     IF ABORT%=1 THEN GOTO STARTING
  320.     IF ASKNUM<>0 THEN SIZ=ASKNUM+SIZ*PLUS%
  321.    CASE ="F"
  322.     IF SIZOPT%=0 THEN
  323.       SIZOPT%=1:SIZOPT$="fixed"
  324.       SIGN=SGN(DSKANGL)*SGN(RNGANGL)
  325.       IF PENINPUT=0 THEN PENINPUT=.001
  326.       LINEUP=(ABS(RATIO)-ABS(PENPOS/PENINPUT)*SIGN)/(ABS(RATIO)+ABS(PENPOS))
  327.     END IF
  328.    CASE ="N"
  329.     IF SIZOPT%=1 THEN
  330.       SIGN=SGN(DSKANGL)*SGN(RNGANGL)
  331.       IF PENINPUT=0 THEN PENINPUT=.001
  332.       NEWLINEUP=(ABS(RATIO)-ABS(PENPOS/PENINPUT)*SIGN)/(ABS(RATIO)+ABS(PENPOS))
  333.       FIXLINEUP=LINEUP/NEWLINEUP
  334.     END IF
  335.     NEST=(ABS(RATIO)-ABS(PENPOS))/(ABS(RATIO)+ABS(PENPOS))
  336.     IF SIZOPT%=1 THEN NEST=FIXLINEUP*NEST
  337.     SIZOPT%=0:SIZOPT$="auto ":SIZ=SIZ*NEST
  338.   END SELECT
  339.  
  340. CASE ="T"
  341. '      TURN SUBROUTINE
  342. ' SETS ROTAT AS THE STARTING ROTATION OF THE RING, INPUT BY THE NUMBER OF
  343. ' DEGREES TO TURN, WHEN SET AT 999, DRAWING CONTINUES FROM WHERE STOPPED IT
  344.  PROMP$="Turn ["+STR$(FIX((ROTAT+.001*SGN(ROTAT))*100)/100)+"]: "
  345.  DEFAU$=STR$(ROTAT):GOSUB INNUM
  346.  IF ABORT%=1 THEN GOTO STARTING
  347.  IF PLUS%=1 THEN ASKNUM=ASKNUM+ROTAT
  348.  ROTAT=ASKNUM
  349.  
  350. CASE ="O"
  351. '      OVAL SUBROUTINE
  352. ' AN OVALNESS GREATER THAN 1 MAKES THE IMAGE THE NORMAL WIDTH, BUT DIVIDES
  353. ' HEIGHT BY OVALNESS GIVING YOU A WIDE, SHORT OVAL.  AN OVALNESS LESS THAN
  354. ' ONE MULTIPLIES THE WIDTH BY OVALNESS, GIVING YOU A TALL, NARROW OVAL
  355.  PROMP$="Oval ["+STR$(FIX((OVALNESS+.001*SGN(OVALNESS))*100)/100)+"]: "
  356.  DEFAU$=STR$(OVALNESS):GOSUB INNUM
  357.  IF ABORT%=1 THEN GOTO STARTING
  358.  OVALNESS=ASKNUM+OVALNESS*PLUS%
  359.  
  360. CASE ="H"
  361. '      HUE SUBROUTINE
  362. ' IN MONOCHROME ODD NUMBERS DRAW IN WHITE, EVEN NUMBERS IN BLACK
  363. ' IN COLOR IT IS UNTESTED, SINCE I USE A HERCULES MONITOR
  364.  PROMP$="Hue ["+STR$(INT(HUE%+.001))+"]: "
  365.  DEFAU$=STR$(HUE%):GOSUB INNUM
  366.  IF ABORT%=1 THEN GOTO STARTING
  367.  HUE%=ASKNUM+HUE%*PLUS%:WHILE HUE%>255:HUE%=HUE%-256:WEND
  368.  IF EXT$=".COL" THEN COL=HUE% MOD 7:COLOR ,INT(COL/3.6)
  369.  
  370. CASE ="W"
  371.  '     WIPE
  372.  'PAINT SUBROUTINE: PAINTS AT CROSSHAIRS
  373.  'ENTER NUMBER OF COLOR OR PATTERN (0-99),
  374.  'OR, AFTER ENTERING A NEGATIVE NUMBER, ENTER A SERIES
  375.  'OF NUMBERS TO INDICATE USER-DEFINED PATTERN
  376.  TILECOLOR%=0:PUT (-150,-100),WNDW%,PSET
  377.  PROMP$="Wipe color? (0-99) ":DEFAU$=STR$(WIPED%):
  378.  GOSUB INNUM
  379.  IF ABORT%=1 THEN GOTO STARTING
  380.  WIPE%=ASKNUM+WIPE%*PLUS%:PROMP$="Pattern? ":WIPED%=WIPE%
  381.  IF WIPE%>9 THEN
  382.    IF TILE$(10)="" THEN
  383.     PUT (-150,102),BLANKLINE%,PSET
  384.     LOCATE 25,1:PRINT "Loading Patterns...";
  385.     FOR X=10 TO 150:READ Y
  386.      WHILE Y<>999
  387.       IF Y=-1 THEN GOTO JUMPOUT
  388.       TILE$(X)=TILE$(X)+CHR$(Y)
  389.       READ Y
  390.      WEND
  391.     NEXT X
  392.    END IF
  393.    JUMPOUT:
  394.    IF WIPE%>100 THEN TILECOLOR%=INT(WIPE%/100):WIPE%=WIPE% MOD 100
  395.    IF WIPE%<>9 THEN WIPE$=TILE$(WIPE%)
  396.  END IF
  397.  IF WIPE%<0 THEN
  398.    WIPE$="":WIPENUM%=0
  399.    WHILE WIPENUM%<256
  400.    DEFAU$=STR$(WIPENUM%):GOSUB INNUM
  401.    IF ABORT%=1 AND NONUM%=0 THEN GOTO STARTING
  402.    IF NONUM%=1 THEN ASKNUM=999
  403.    WIPENUM%=ASKNUM+WIPENUM%*PLUS%
  404.    IF WIPENUM%<0 THEN
  405.      WIPE$=OLDWIPE$:OLDPROMP$="Pattern? "
  406.      FOR X=1 TO LEN(WIPE$)
  407.      OLDPART$=STR$(ASC(MID$(WIPE$,X,1)))
  408.      OLDPROMP$=OLDPROMP$+MID$(OLDPART$,2,LEN(OLDPART$)-1)+CHR$(249)
  409.      NEXT X:PROMP$=OLDPROMP$
  410.    ELSE
  411.     IF WIPENUM%<256 THEN WIPE$=WIPE$+CHR$(WIPENUM%)
  412.     PROMP$=PROMP$+RIGHT$(STR$(WIPENUM%),LEN(STR$(WIPENUM%))-1)+CHR$(249)
  413.    END IF
  414.    WEND
  415.  END IF
  416.  IF TILECOLOR%<>0 THEN GOSUB COLORTILE
  417.  IF WIPE%<9 AND WIPE%=>0 THEN
  418.   IF EXT$=".COL" THEN COLOR ,INT(WIPE%/4.1)
  419.   ON ERROR GOTO STACKSPACE
  420.   PAINT (MOVHORIZ,MOVVERT),WIPE%,HUE%
  421.  ELSE
  422.   PAINT (MOVHORIZ,MOVVERT),WIPE$,HUE%
  423.   OLDWIPE$=WIPE$
  424.   ON ERROR GOTO 0
  425.  END IF
  426.  GET (-150,-100)-(14*WD-146,24*HG-100),WNDW%
  427.  PUT (-150,102),BLANKLINE%,PSET
  428.  LOCATE 25,1:PRINT ">";
  429.  
  430. CASE ="F"
  431. '      FORM SUBROUTINE
  432. ' TOGGLE BETWEEN INPUT BY NUMBER OF GEARS AND INPUT BY NUMBER OF DEGREES
  433. ' WHEN FORM IS 'DEGREES' THERE ARE A COUPLE DIFFERENCES IN THE WAY THE IMAGE
  434. ' IS DRAWN.  1. THE SIZE OF THE DISK AND RING ARE NOT SET IN PROPORTION
  435. ' TO THE NUMBER OF GEARS. 2. THE DISK SIMPLY TURNS X NUMBER OF DEGREES, IT
  436. ' DOES NOT ROLL INSIDE THE RING.
  437.  GDTOGL%=ABS(GDTOGL%-1):PUT (-150,102),BLANKLINE%,PSET
  438.  LOCATE 25,1:IF GDTOGL%=1 THEN PRINT "Form:gears"; ELSE PRINT "Form:degrees";
  439.  
  440. CASE ="L"
  441. '      LOAD/SAVE SUBROUTINE
  442.  IF REP%=1 THEN GOTO REPEAT
  443.  PROMP$="(D)isk or (M)emory?"
  444.  CHOIC$="DM":DEFAU$=""
  445.  GOSUB INWORD
  446.  SCREENSAVE$=ASKWRD$
  447.  SELECT CASE SCREENSAVE$
  448.         CASE ="D"
  449.           PROMP$="(L)oad or (S)ave?"
  450.           CHOIC$="SL"
  451.           DEFAU$=""
  452.           GOSUB INWORD
  453.           IF ABORT%=1 THEN GOTO STARTING
  454.           IF ASKWRD$<>"" THEN
  455.             SL$=ASKWRD$
  456.             PROMP$="File name ["+FIL$+"]: "
  457.             CHOIC$=""
  458.             DEFAU$=FIL$
  459.             GOSUB INWORD
  460.             IF ABORT%=1 THEN GOTO STARTING
  461.             IF ASKWRD$<>"" THEN FIL$=ASKWRD$
  462.             GOSUB FILEXIST
  463.             IF FILECONTINUE=1 THEN
  464.              SELECT CASE SL$
  465.                     CASE ="S"
  466.                       IF MENU%=1 THEN PUT (-150,-100),WNDW%,PSET
  467.                       ON ERROR GOTO CANTSAVE
  468.                       BSAVE FIL$,0,FILESIZ
  469.                       ON ERROR GOTO 0
  470.                     CASE ="L"
  471.                       BLOAD FIL$,0
  472.                       GET (-150,-100)-(14*WD-146,24*HG-100),WNDW%
  473.                       WHILE NOT INSTAT:WEND
  474.                       KK$=INKEY$
  475.              END SELECT
  476.             END IF
  477.           END IF
  478.         CASE ="M"
  479. '               VIDEO-REFRESH
  480.            PROMP$="Save or Restore:"
  481.            CHOIC$="SR"
  482.            DEFAU$=""
  483.            GOSUB INWORD
  484.            IF ABORT%=1 THEN GOTO STARTING
  485.            FRESH$=ASKWRD$
  486.            SELECT CASE FRESH$
  487.                   CASE ="S"
  488.                     PUT (-150,-100),WNDW%,PSET
  489.                     GET (-150,-100)-(150,100),REFRESHA%
  490.                   CASE ="R"
  491.                     PROMP$="Restore, Negative, Sum, Icon? "
  492.                     CHOIC$="RNSI"
  493.                     DEFAU$=""
  494.                     GOSUB INWORD
  495.                     IF ABORT%=1 THEN GOTO STARTING
  496.                     PUT (-150,-100),WNDW%,PSET
  497.                     SELECT CASE  ASKWRD$
  498.                            CASE ="R"
  499.                              PUT (-150,-100),REFRESHA%,PSET
  500.                              GET (-150,-100)-(14*WD-146,24*HG-100),WNDW%
  501.                            CASE ="N"
  502.                              PUT (-150,-100),REFRESHA%,PRESET
  503.                              GET (-150,-100)-(14*WD-146,24*HG-100),WNDW%
  504.                            CASE ="S"
  505.                              PUT (-150,-100),REFRESHA%,OR
  506.                              GET (-150,-100)-(14*WD-146,24*HG-100),WNDW%
  507.                            CASE ="I"
  508.                              PUT (-150,-100),REFRESHA%,XOR
  509.                              GET (-150,-100)-(14*WD-146,24*HG-100),WNDW%
  510.                     END SELECT
  511.            END SELECT
  512.            IF REP%=2 THEN GOTO REPEAT
  513.  END SELECT
  514.  
  515.  CASE ="I"
  516. '       INITIALIZE SUBROUTINE, RESETS MOST VARIABLES TO THEIR STARTING VALUES
  517. ' DOES NOT EFFECT DISK, RING, FORM, OR AGAIN COMMANDS
  518.  MOVVERT=0:MOVHORIZ=0:ROTAT=0:SIZ=1
  519.  PENPOS=1:RATIO=1:PENINPUT=1:MENU%=1
  520.  OVALNESS=1:HUE%=1:SIZOPT%=0:SIZOPT$="auto"
  521.  LOCATED$="":FIL$="SPIRO1"+EXT$
  522.  PUT (-150,102),BLANKLINE%,PSET
  523.  LOCATE 25,1:PRINT "Initialized!";
  524.  
  525.   CASE ="V"
  526.  '       VERSION: A BASICALLY USELESS SUBROUTINE
  527.   PUT (-150,-100),WNDW%,PSET:PUT (-150,-100),WNDW%
  528.   LOCATE 3,1:PRINT "SPROGH!"
  529.   LOCATE 5,1:PRINT "version 3.1"
  530.   LOCATE 9,1:PRINT "by"
  531.   LOCATE 10,1:PRINT "Phil Paustian"
  532.   LOCATE 11,1:PRINT "Box 644"
  533.   LOCATE 12,1:PRINT "Terry, MT"
  534.   LOCATE 13,4:PRINT "59349"
  535.   LOCATE 15,2:PRINT "REGISTER"
  536.   LOCATE 16,7:PRINT "NOW!"
  537.   LOCATE 19,1:PRINT "Send $4.37 if"
  538.   LOCATE 20,1:PRINT "you enjoyed"
  539.   LOCATE 21,1:PRINT "this program."
  540.   PUT (-150,102),BLANKLINE%,PSET
  541.   LOCATE 25,1:PRINT "Press any key to continue";
  542.   WHILE NOT INSTAT:WEND:V$=INKEY$
  543.   PUT (-150,-100),WNDW%,PSET
  544.  
  545. CASE ="Z"
  546. '      ZERO: DOES NOTHING BUT WAITS ONE SECOND AND BEEPS
  547. ' THE ONLY CONCEIVABLE USE IS TO PUT A DELAY INTO "AGAIN" COMMANDS
  548.   DELAY 1:SOUND 100,4
  549.  
  550. CASE ="E"
  551. ' EXAMPLES SUBROUTINE
  552.  IF GDTOGL%=1 THEN
  553.    SELECT CASE SAMPLE%
  554.    CASE =0
  555.      CLS:GET (-150,-100)-(14*WD-146,24*HG-100),WNDW%
  556. INMACRO$="ID16R72P.4GP.5H3GP.6H5GSNT+20H7GP.8H1GP1H3GSNP1.5H5GP2.1H7GP2.7H1G"
  557.      MACRO$=INMACRO$:MACRO%=1:REP%=2
  558.    CASE =1
  559.      REP%=2:MACRO%=11:PENINPUT=1.1:SIZOPT%=0:SIZOPT$="auto ":siz=1
  560.      CLS:GET (-150,-100)-(14*WD-146,24*HG-100),WNDW%
  561.      INMACRO$="D40R60SFP+-.1G":MACRO$=INMACRO$
  562.    CASE =2
  563.      PENINPUT=.4:ROTAT=-3:REP%=2
  564.      CLS:GET (-150,-100)-(14*WD-146,24*HG-100),WNDW%
  565.      INMACRO$="D20R60SA1T+3P+.05G":REP%=2:MACRO%=30:MACRO$=INMACRO$
  566.    END SELECT
  567.    SAMPLE%=SAMPLE%+1:IF SAMPLE%>2 THEN SAMPLE%=0
  568.   ELSE
  569.    ROTAT=0:REP%=2:MACRO%=1
  570.    SELECT CASE SAMPL%
  571.    CASE =0
  572.     INMACRO$="ID124R2P.9CGZD2R60P1H3CGZE":MACRO$=INMACRO$
  573.    CASE =1
  574.     INMACRO$="D58R266P1H7CGZD141R141H1CGW93MR135W93ML135ZE":MACRO$=INMACRO$
  575.    CASE =2
  576.     INMACRO$="LMRNH0D44R278SA1.5O1.5LMRSGZD4R93LMRNLMRSGZE":MACRO$=INMACRO$
  577.    END SELECT
  578.    SAMPL%=SAMPL%+1:IF SAMPL%>2 THEN SAMPL%=0
  579.   END IF
  580.   GOTO REPEAT
  581.  
  582. CASE ="A"
  583. '    AGAIN SUBROUTINE
  584. ' ALLOWS INPUT OF MACRO$ FOR AUTOMATIC REPETITION OF COMMANDS
  585. ' AN 'A' ANYWHERE WITHIN MACRO$ WILL RESET MACRO$ AND PUT YOU
  586. ' IN AN ENDLESS LOOP (HITTING ESCAPE, OR ANY KEY WILL END LOOP)
  587.  IF REP%=2 THEN MACRO$=INMACRO$:GOTO REPEAT
  588.  PROMP$="AGAIN:":CHOIC$="":DEFAU$=INMACRO$
  589.  GOSUB INWORD
  590.  IF ABORT%=1 THEN GOTO STARTING
  591.  IF ASKWRD$<>"" THEN INMACRO$=ASKWRD$
  592.  MACRO$=INMACRO$
  593.  IF MACRO$<>"" THEN
  594.    IF RIGHT$(MACRO$,1)="A" THEN LOOPA=1 ELSE LOOPA=0
  595.    IF LOOPA=0 THEN
  596.      PROMP$="HOW MANY TIMES? "
  597.      DEFAU$=""
  598.      GOSUB INNUM
  599.      IF ABORT%=1 THEN GOTO STARTING
  600.      IF ASKNUM<>0 THEN MACRO%=ASKNUM:REP%=2:GOTO REPEAT
  601.    ELSE
  602.      PROMP$="Start drawing (Y or N)?"
  603.      CHOIC$="YN":DEFAU$=""
  604.      GOSUB INWORD
  605.      IF ABORT%=1 THEN GOTO STARTING
  606.      IF ASKWRD$="Y" THEN MACRO%=1:REP%=2:GOTO REPEAT
  607.    END IF
  608.  END IF
  609.  
  610. CASE ="B"
  611. '    BLANK SCREEN SUBROUTINE
  612. ' TOGGLE THAT DETERMINES IF MENU IS TO BE PRINTED ON LEFT SIDE OF SCREEN
  613.  MENU%=ABS(MENU%-1):IF MENU%=0 THEN PUT (-150,-100),WNDW%,PSET
  614.  
  615. CASE ="C"
  616. '    CLEAR SCREEN SUBROUTINE
  617.  CLS:GET (-150,-100)-(14*WD-146,24*HG-100),WNDW%
  618.  LOCATE 25,1:PRINT ">";
  619.  
  620. CASE ="G"
  621. '    GO SUBROUTINE, THIS SECTION DOES ALL THE DRAWING
  622.  IF REP%=2 AND VAL(MACRO$)<>0 THEN
  623.     PROMP$="GO ":GOSUB INNUM:RECOUNT%=ASKNUM
  624.  END IF
  625.  IF DSKANGL*RNGANGL=0 THEN
  626.   PUT (-150,102),BLANKLINE%,PSET
  627.   LOCATE 25,1:PRINT "YOU MUST SET RING AND DISK FIRST";
  628.   GOTO STARTING
  629.  END IF
  630. WHILE ABS(DSKANGL)>CIR:DSKANGL=DSKANGL-CIR*SGN(DSKANGL):WEND
  631. WHILE ABS(RNGANGL)>CIR:RNGANGL=RNGANGL-CIR*SGN(RNGANGL):WEND
  632.  PUT (-150,-100),WNDW%,PSET
  633.  IF GDTOGL%=1 THEN
  634.    RATIO=DSKANGL/RNGANGL
  635.    IF RATIO<>-1 THEN PENPOS=PENINPUT/(RATIO+1)*RATIO ELSE PENPOS=-PENINPUT
  636.  ELSE
  637.    RATIO=1:PENPOS=PENINPUT
  638.  END IF
  639. SIZCONST=100/(ABS(RATIO)+ABS(PENPOS))
  640. IF SIZOPT%=1 THEN
  641.   SIGN=SGN(DSKANGL)*SGN(RNGANGL)
  642.   IF PENINPUT=0 THEN PENINPUT=.001
  643.   NEWLINEUP=(ABS(RATIO)-ABS(PENPOS/PENINPUT)*SIGN)/(ABS(RATIO)+ABS(PENPOS))
  644.   FIXLINEUP=LINEUP/NEWLINEUP
  645.   SIZCONST=SIZCONST*FIXLINEUP
  646. END IF
  647. IF OVALNESS>1 THEN
  648.    OVALWIDE=1/OVALNESS:OVALHIGH=1
  649. ELSE
  650.    OVALWIDE=1:OVALHIGH=OVALNESS
  651. END IF
  652. ROTE=ROTAT
  653. IF ROTE<>999 THEN
  654.   WHILE ROTE>360:ROTE=ROTE-360:WEND
  655.   WHILE ROTE<0:ROTE=ROTE+360:WEND
  656.   DSKPLOT=0:RNGPLOT=ROTE*PI
  657. END IF
  658. IF EXT$=".COL" THEN COL=HUE% MOD 7:COLOR ,INT(COL/3.6)
  659. DSKMEM=DSKPLOT:RNGMEM=RNGPLOT
  660. PUT (-150,102),BLANKLINE%,PSET
  661. HORIZSCALE=SIZ*OVALHIGH*SIZCONST
  662. VERTSCALE=SIZ*OVALWIDE*SIZCONST
  663. PLOTHOR=SIN(DSKPLOT+RNGPLOT*GDTOGL%)*PENPOS+SIN(RNGPLOT)*RATIO
  664. PLOTVERT=COS(DSKPLOT+RNGPLOT*GDTOGL%)*PENPOS+COS(RNGPLOT)*RATIO
  665. PSET(MOVHORIZ+PLOTHOR*HORIZSCALE,MOVVERT+PLOTVERT*VERTSCALE),HUE%
  666. COUNT%=0
  667. '     HERE IS THE ACTUAL PLOTTING OF THE DESIGN
  668.  WHILE NOT INSTAT
  669.    COUNT%=COUNT%+1
  670.    DSKPLOT=DSKPLOT+DSKANGL
  671.    RNGPLOT=RNGPLOT+RNGANGL
  672.    WHILE ABS(DSKPLOT)>CIR:DSKPLOT=DSKPLOT-CIR*SGN(DSKPLOT):WEND
  673.    WHILE ABS(RNGPLOT)>CIR:RNGPLOT=RNGPLOT-CIR*SGN(RNGPLOT):WEND
  674.    PLOTHOR=SIN(DSKPLOT+RNGPLOT*GDTOGL%)*PENPOS+SIN(RNGPLOT)*RATIO
  675.    PLOTVERT=COS(DSKPLOT+RNGPLOT*GDTOGL%)*PENPOS+COS(RNGPLOT)*RATIO
  676.    LINE -(MOVHORIZ+PLOTHOR*HORIZSCALE,MOVVERT+PLOTVERT*VERTSCALE),HUE%
  677.    IF RECOUNT%=0 AND COUNT%>10 THEN
  678.     DM=ABS(DSKPLOT)-ABS(DSKMEM):RM=ABS(RNGPLOT)-ABS(RNGMEM)
  679.     IF ABS(DM)<ZERO OR ABS(DM)>CIR-ZERO THEN
  680.       IF ABS(RM)<ZERO OR ABS(RM)>CIR-ZERO THEN GOTO DONE
  681.     END IF
  682.    END IF
  683.    IF RECOUNT%=1 THEN
  684.      RECOUNT%=0
  685.      GOTO DONE
  686.    END IF
  687.    IF RECOUNT%<>0 THEN RECOUNT%=RECOUNT%-1
  688.  WEND
  689.  IF REP%=1 THEN GOTO SCRENE
  690.  REP%=0
  691.  KK$=UCASE$(INKEY$):RECOUNT%=0
  692.  DONE:
  693.  GET (-150,-100)-(14*WD-146,24*HG-100),WNDW%
  694.  PUT (-150,102),BLANKLINE%,PSET
  695.  LOCATE 25,1:PRINT ">";
  696.  SELECT CASE REP%
  697.         CASE =0
  698.           GOTO STARTING
  699.         CASE =1
  700.           GOTO INTROSCREEN
  701.         CASE =2
  702.           GOTO REPEAT
  703.  END SELECT
  704.  
  705. CASE ="Q"
  706. '    QUIT SUBROUTINE
  707.   PUT (-150,102),BLANKLINE%,PSET
  708.   LOCATE 25,1:PRINT "ARE YOU SURE? ";
  709.   WHILE NOT INSTAT:WEND
  710.   KK$=UCASE$(INKEY$)
  711.   IF KK$="Y" THEN
  712.     CLS
  713.     LOCATE 1,1:PRINT "Have a nice day!"
  714.     RANDOMIZE TIMER:HUE%=1
  715.     WHILE NOT INSTAT
  716.     IF SCRN$="C" THEN
  717.       HUE%=INT(RND(2)*6+1)
  718.       IF HUE%>3 THEN COLOR ,1:HUE%=HUE%-3 ELSE COLOR ,0
  719.     END IF
  720.     S1=INT(RND(2)*14+2)
  721.     S2=INT(RND(2)*(300-20*S1))-150
  722.     S3=INT(RND(2)*29+2)
  723.     S4=INT(RND(2)*(200-5*S3))-100
  724.     GET (2*S1+S2,2*S3+S4)-(19*S1+S2,3*S3+S4),REFRESHA%
  725.     PUT (2*S1+S2,2*S3+S4),REFRESHA%
  726.     GET (S1+S2,3*S3+S4)-(19*S1+S2,4*S3+S4),REFRESHA%
  727.     PUT (S1+S2,3*S3+S4),REFRESHA%
  728.     GET (3*S1+S2,S3+S4)-(5*S1+S2,2*S3+S4),REFRESHA%
  729.     PUT (3*S1+S2,S3+S4),REFRESHA%
  730.     GET (16*S1+S2,S3+S4)-(17*S1+S2,2*S3+S4),REFRESHA%
  731.     PUT (16*S1+S2,S3+S4),REFRESHA%
  732.     GET (5*S1+S2,4*S3+S4)-(6*S1+S2,5*S3+S4),REFRESHA%
  733.     PUT (5*S1+S2,4*S3+S4),REFRESHA%
  734.     GET (15*S1+S2,4*S3+S4)-(16*S1+S2,5*S3+S4),REFRESHA%
  735.     PUT (15*S1+S2,4*S3+S4),REFRESHA%
  736.     GOSUB LOGO
  737.     DELAY .3
  738.     WEND
  739.     LOCATE 25,30:PRINT "The end?";
  740.     DELAY .5
  741.     SCREEN 0,0,0,0:END
  742.   END IF
  743.   PUT (-150,102),BLANKLINE%,PSET
  744.   LOCATE 25,1:PRINT ">";
  745.  
  746. END SELECT
  747.   IF REP%=0 THEN GOTO STARTING ELSE GOTO REPEAT
  748.  
  749.  
  750. FILEXIST:
  751.   FILERR=0:FILECONTINUE=0
  752.   ON ERROR GOTO FILERROR
  753.   OPEN FIL$ FOR INPUT AS #1
  754.   CLOSE 1
  755. CONTINUEAFTERERROR:
  756.   ON ERROR GOTO 0
  757.   IF SL$="S" THEN
  758.     IF FILERR=0 THEN
  759.       PROMP$=CHR$(34)+FIL$+CHR$(34)+" exists. Overwrite?"
  760.       CHOIC$="YN"
  761.       DEFAU$=""
  762.       GOSUB INWORD
  763.       IF ASKWRD$="Y" THEN FILECONTINUE=1
  764.     ELSE
  765.       FILECONTINUE=1
  766.     END IF
  767.   ELSE
  768.     IF FILERR=1 THEN
  769.       PUT (-150,102),BLANKLINE%,PSET
  770.       LOCATE 25,1:PRINT CHR$(34);FIL$;CHR$(34);" doesn't exist";
  771.     ELSE
  772.       FILECONTINUE=1
  773.     END IF
  774.   END IF
  775.   RETURN
  776. FILERROR:
  777.   FILERR=1:RESUME CONTINUEAFTERERROR
  778. CANTSAVE:
  779.   PUT (-150,102),BLANKLINE%,PSET
  780.   LOCATE 25,1:PRINT "Cannot save";
  781.   RESUME NEXT
  782. STACKSPACE:
  783.   PUT (-150,102),BLANKLINE%,PSET
  784.   LOCATE 25,1:PRINT "Out of stack space";
  785.   RESUME NEXT
  786.  
  787. LOGO:
  788. LINE (4*S1+S2,1*S3+S4)-(5*S1+S2,1*S3+S4),HUE%
  789. LINE (16*S1+S2,1*S3+S4)-(17*S1+S2,1*S3+S4),HUE%
  790. LINE (4*S1+S2,2*S3+S4)-(16*S1+S2,2*S3+S4),HUE%
  791. LINE (17*S1+S2,2*S3+S4)-(19*S1+S2,2*S3+S4),HUE%
  792. LINE (2*S1+S2,3*S3+S4)-(4*S1+S2,3*S3+S4),HUE%
  793. LINE (6*S1+S2,3*S3+S4)-(7*S1+S2,3*S3+S4),HUE%
  794. LINE (9*S1+S2,3*S3+S4)-(10*S1+S2,3*S3+S4),HUE%
  795. LINE (11*S1+S2,3*S3+S4)-(12*S1+S2,3*S3+S4),HUE%
  796. LINE (14*S1+S2,3*S3+S4)-(15*S1+S2,3*S3+S4),HUE%
  797. LINE (17*S1+S2,3*S3+S4)-(18*S1+S2,3*S3+S4),HUE%
  798. LINE (1*S1+S2,4*S3+S4)-(5*S1+S2,4*S3+S4),HUE%
  799. LINE (6*S1+S2,4*S3+S4)-(9*S1+S2,4*S3+S4),HUE%
  800. LINE (10*S1+S2,4*S3+S4)-(15*S1+S2,4*S3+S4),HUE%
  801. LINE (16*S1+S2,4*S3+S4)-(17*S1+S2,4*S3+S4),HUE%
  802. LINE (18*S1+S2,4*S3+S4)-(19*S1+S2,4*S3+S4),HUE%
  803. LINE (1*S1+S2,4*S3+S4)-(4*S1+S2,1*S3+S4),HUE%
  804. LINE (5*S1+S2,5*S3+S4)-(6*S1+S2,5*S3+S4),HUE%
  805. LINE (15*S1+S2,5*S3+S4)-(16*S1+S2,5*S3+S4),HUE%
  806. LINE (5*S1+S2,1*S3+S4)-(5*S1+S2,5*S3+S4),HUE%
  807. LINE (6*S1+S2,4*S3+S4)-(6*S1+S2,5*S3+S4),HUE%
  808. LINE (8*S1+S2,2*S3+S4)-(8*S1+S2,4*S3+S4),HUE%
  809. LINE (9*S1+S2,3*S3+S4)-(9*S1+S2,4*S3+S4),HUE%
  810. LINE (10*S1+S2,2*S3+S4)-(10*S1+S2,4*S3+S4),HUE%
  811. LINE (13*S1+S2,2*S3+S4)-(13*S1+S2,4*S3+S4),HUE%
  812. LINE (15*S1+S2,4*S3+S4)-(15*S1+S2,5*S3+S4),HUE%
  813. LINE (16*S1+S2,1*S3+S4)-(16*S1+S2,5*S3+S4),HUE%
  814. LINE (17*S1+S2,1*S3+S4)-(17*S1+S2,2*S3+S4),HUE%
  815. LINE (17*S1+S2,3*S3+S4)-(17*S1+S2,4*S3+S4),HUE%
  816. LINE (18*S1+S2,3*S3+S4)-(18*S1+S2,4*S3+S4),HUE%
  817. LINE (19*S1+S2,2*S3+S4)-(19*S1+S2,4*S3+S4),HUE%
  818. RETURN
  819.  
  820. INNUM:
  821. '    INPUT NUMBERS ON SCREEN LINE 25.
  822. ' ONLY ALLOWS NUMERIC CHARACTERS TO BE ENTERED,
  823. ' ALLOWS USE OF BACKSPACE, RIGHT AND LEFT ARROWS, AND ESCAPE,
  824. ' THE '5' KEY TYPES OUT THE ENTIRE DEFAULT
  825. ' AN INITIAL '+' MEANS THE INPUT WILL BE ADDED TO THE DEFAULT,
  826. ' TO SUBRACT FROM DEFAULT, START WITH '+-'
  827.    ASKNUM$=DEFAU$:ABORT%=0:PLUS%=0:KPOS%=0:NONUM%=0
  828.    IF VAL(DEFAU$)>0 THEN ASKNUM$=RIGHT$(DEFAU$,LEN(DEFAU$)-1)
  829.    PUT (-150,102),BLANKLINE%,PSET
  830.    IF LEN(PROMP$)<LINELENGTH% THEN
  831.      LIN%=25:LOCATE LIN%,1:PRINT PROMP$;
  832.    ELSE
  833.      FOR X=1 TO LEN(PROMP$)/LINELENGTH%+1
  834.      LOCATE 26-X,1:PRINT MID$(PROMP$,(X-1)*LINELENGTH%+1,LINELENGTH%);
  835.      NEXT X
  836.    END IF
  837.  ANOTHERNUMBER:
  838.    IF REP%=2 THEN
  839.      IF LEN(MACRO$)<>0 THEN KK$=LEFT$(MACRO$,1) ELSE KK$=CHR$(13)
  840.      IF ASC(KK$)>42 AND ASC(KK$)<58 THEN
  841.        MACRO$=RIGHT$(MACRO$,LEN(MACRO$)-1)
  842.      ELSE
  843.        KK$=CHR$(13)
  844.      END IF
  845.    ELSE
  846.      WHILE NOT INSTAT:WEND:KK$=UCASE$(INKEY$)
  847.    END IF
  848.    IF KK$=CHR$(27) THEN
  849.       PUT (-150,102),BLANKLINE%,PSET
  850.       ABORT%=1:LOCATE 25,1:PRINT ">";:RETURN
  851.    END IF
  852.    IF RIGHT$(KK$,1)=CHR$(75) AND LEN(KK$)=2 THEN KK$=CHR$(8)
  853.    IF LEN(KK$)=2 AND RIGHT$(KK$,1)=CHR$(76) THEN
  854.        PRINT RIGHT$(ASKNUM$,LEN(ASKNUM$)-KPOS%);
  855.        KPOS%=LEN(ASKNUM$)
  856.    END IF
  857.    IF LEN(KK$)=2 AND RIGHT$(KK$,1)=CHR$(77) THEN
  858.        IF LEN(ASKNUM$)>KPOS% THEN KK$=MID$(ASKNUM$,KPOS%+1,1)
  859.    END IF
  860.    IF KK$=CHR$(8) AND KPOS%>0 THEN
  861.        KPOS%=KPOS%-1:LOCATE CSRLIN,POS-1:PRINT " ";:LOCATE 25,POS-1
  862.    END IF
  863.    IF ASC(KK$)>42 AND ASC(KK$)<58 AND ASC(KK$)<>47 THEN
  864.      IF LEN(ASKNUM$)>KPOS% THEN
  865.         RGHT$=RIGHT$(ASKNUM$,LEN(ASKNUM$)-KPOS%-1)
  866.      ELSE
  867.         RGHT$=""
  868.      END IF
  869.      ASKNUM$=LEFT$(ASKNUM$,KPOS%)+KK$+RGHT$
  870.      KPOS%=KPOS%+1:PRINT KK$;
  871.    END IF
  872.    IF KK$<>CHR$(13) THEN GOTO ANOTHERNUMBER
  873.    IF KPOS%=0 THEN ABORT%=1:NONUM%=1
  874.    ASKNUM$=LEFT$(ASKNUM$,KPOS%)
  875.    IF LEFT$(ASKNUM$,1)=CHR$(43) THEN
  876.       ASKNUM$=RIGHT$(ASKNUM$,LEN(ASKNUM$)-1):PLUS%=1
  877.    END IF
  878.    ASKNUM=VAL(ASKNUM$)
  879.    WHILE ASKNUM>32768:ASKNUM=ASKNUM/10:WEND
  880.    IF KPOS%=0 AND WIPE%=1 THEN ASKNUM=999
  881.    PUT (-150,102),BLANKLINE%,PSET
  882.    LOCATE 25,1:PRINT ">";
  883.    RETURN
  884.  
  885. INWORD:
  886. '    INPUT WORDS OR LETTERS ON SCREEN LINE 25.
  887. ' ALLOWS ONLY LEGAL CHOICES TO BE INPUT,
  888. ' ALLOWS BACKSPACE, ESCAPE, AND RIGHT AND LEFT ARROWS,
  889. ' THE '5' KEY TYPES OUT THE ENTIRE DEFAULT STRING.
  890.   ASKWRD$=DEFAU$:ABORT%=0:KPOS%=0
  891.   PUT (-150,102),BLANKLINE%,PSET
  892.   LOCATE 25,1:PRINT PROMP$;
  893.  ANOTHERLETTER:
  894.   IF REP%=2 AND MACRO$<>"" THEN
  895.     KK$=LEFT$(MACRO$,1)
  896.     MACRO$=RIGHT$(MACRO$,LEN(MACRO$)-1)
  897.   ELSE
  898.     WHILE NOT INSTAT:WEND
  899.     KK$=UCASE$(INKEY$)
  900.   END IF
  901.   IF KK$=CHR$(27) THEN
  902.     PUT (-150,102),BLANKLINE%,PSET
  903.     ABORT%=1:LOCATE 25,1:PRINT ">";:RETURN
  904.   END IF
  905.   IF LEN(KK$)=2 AND RIGHT$(KK$,1)=CHR$(75) THEN KK$=CHR$(8)
  906.   IF LEN(KK$)=2 AND RIGHT$(KK$,1)=CHR$(76) THEN
  907.     PRINT RIGHT$(ASKWRD$,LEN(ASKWRD$)-KPOS%);:KPOS%=LEN(ASKWRD$)
  908.   END IF
  909.   IF LEN(KK$)=2 AND RIGHT$(KK$,1)=CHR$(77) THEN
  910.     IF LEN(ASKWRD$)>KPOS% THEN KK$=MID$(ASKWRD$,KPOS%+1,1)
  911.   END IF
  912.   IF KK$=CHR$(8) AND KPOS%>0 THEN
  913.     KPOS%=KPOS%-1
  914.     LOCATE 25,POS-1:PRINT " ";:LOCATE 25,POS-1
  915.   END IF
  916.   IF INSTR(CHOIC$,KK$)<>0 OR CHOIC$="" THEN
  917.    IF ASC(KK$)>32 THEN
  918.      IF LEN(ASKWRD$)>KPOS% THEN
  919.        RGHT$=RIGHT$(ASKWRD$,LEN(ASKWRD$)-KPOS%-1)
  920.      ELSE
  921.        RGHT$=""
  922.      END IF
  923.      ASKWRD$=LEFT$(ASKWRD$,KPOS%)+KK$+RGHT$
  924.      KPOS%=KPOS%+1:PRINT KK$;
  925.    END IF
  926.   END IF
  927.   IF CHOIC$="" AND KK$<>CHR$(13) THEN GOTO ANOTHERLETTER
  928.   ASKWRD$=LEFT$(ASKWRD$,KPOS%)
  929.   PUT (-150,102),BLANKLINE%,PSET
  930.   LOCATE 25,1:PRINT ">";:RETURN
  931.  
  932. REPEAT:
  933. '    READS COMMANDS FROM MACRO$ WHEN RUNNING MACROS (THE 'A' COMMAND)
  934.  IF MACRO$="" THEN MACRO%=MACRO%-1:MACRO$=INMACRO$
  935.  IF MACRO%=0 THEN REP%=0:GOTO STARTING
  936.  KY$=LEFT$(MACRO$,1)
  937.  MACRO$=RIGHT$(MACRO$,LEN(MACRO$)-1)
  938.  GOTO SET
  939.  
  940. COLORTILE:
  941. '  CHANGES COLORS IN TILE PATTERNS FOR WIPE COMMAND
  942. IF EXT$=".COL" THEN
  943.  IF TILECOLOR% MOD 12 >5 THEN
  944.   COL=HUE% MOD 7:COLOR ,1-INT(COL/3.6)
  945.  END IF
  946. END IF
  947. WIPE1$=WIPE$
  948. FOR TILEPART=1 TO LEN(WIPE$)
  949.  TILER%(0)=ASC(MID$(WIPE$,TILEPART,1))
  950.  SELECT CASE TILECOLOR% MOD 5
  951.   CASE =1
  952.     TILER%(0)=TILER%(0)*2
  953.     WHILE TILER%(0)>255:TILER%(0)=TILER%(0)-255:WEND
  954.   CASE =2
  955.     TILER%(0)=255-TILER%(0)
  956.   CASE =3
  957.     T1%=TILER%(0):T3%=0
  958.     FOR T2%=1 TO 8
  959.      T3%=T3%*2
  960.      IF T1% MOD 2=1 THEN T3%=T3%+1
  961.      T1%=INT(T1%/2)
  962.     NEXT T2%
  963.     TILER%(0)=T3%
  964.   CASE =4
  965.     TILER%(0)=ASC(MID$(WIPE$,LEN(WIPE$)-TILEPART+1,1))
  966.   END SELECT
  967.  TILER%(1)=TILER%(0) MOD 4
  968.  TILER%(2)=(TILER%(0)-TILER%(1))/4 MOD 4
  969.  TILER%(3)=(TILER%(0)-TILER%(1)-TILER%(2)*4)/16 MOD 4
  970.  TILER%(4)=(TILER%(0)-TILER%(1)-TILER%(2)*4-TILER%(3)*16)/64
  971.  FOR TLC=1 TO 4
  972.   SELECT CASE INT(TILECOLOR%/12) MOD 6
  973.          CASE =1
  974.           IF TILER%(TLC)>1 THEN TILER%(TLC)=5-TILER%(TLC)
  975.          CASE =2
  976.           IF TILER%(TLC)=1 OR TILER%(TLC)=2 THEN TILER%(TLC)=3-TILER%(TLC)
  977.          CASE =3
  978.           IF TILER%(TLC)<2 THEN TILER%(TLC)=1-TILER%(TLC)
  979.          CASE =4
  980.           IF TILER%(TLC)=0 OR TILER%(TLC)=3 THEN TILER%(TLC)=3-TILER%(TLC)
  981.          CASE =5
  982.           IF TILER%(TLC)=0 OR TILER%(TLC)=2 THEN TILER%(TLC)=2-TILER%(TLC)
  983.   END SELECT
  984.  NEXT TLC
  985.  TILER%(0)=TILER%(1)+TILER%(2)*4+TILER%(3)*16+TILER%(4)*64
  986.  WHILE TILER%(0)>255:TILER%(0)=TILER%(0)-255:WEND
  987.  MID$(WIPE1$,TILEPART,1)=CHR$(TILER%(0))
  988. NEXT TILEPART
  989. WIPE$=WIPE1$
  990. RETURN
  991.  
  992. ' PATTERNS 10-19
  993. DATA 1,999
  994. DATA 15,999
  995. DATA 127,999 '
  996. DATA 17,999
  997. DATA 21,999  '
  998. DATA 17,17,1,17,1,17,17,16,17,16,999
  999. DATA 1,1,1,1,17,17,16,16,16,16,17,17,999
  1000. DATA 144,144,18,18,66,66,72,72,9,9,33,33,36,36,132,132,999
  1001. DATA 75,999
  1002. DATA 93,93,65,65,999
  1003.  
  1004. ' PATTERNS 20-29
  1005. DATA 1,16,17,0,999
  1006. DATA 255,255,0,999
  1007. DATA 255,0,0,0,0,0,999
  1008. DATA 31,0,0,0,0,999
  1009. DATA 63,0,0,0,243,0,0,0,999
  1010. DATA 31,0,227,0,124,0,143,0,241,0,62,0,199,0,248,0,999
  1011. DATA 85,170,0,85,85,0,0,0,999
  1012. DATA 0,0,170,85,0,85,170,0,170,85,0,0,255,0,0,255,999
  1013. DATA 85,170,0,0,255,0,0,85,85,0,0,255,0,0,999
  1014. DATA 85,170,85,255,255,255,170,85,170,0,0,0,999
  1015.  
  1016. ' PATTERNS 30-39
  1017. DATA 255,3,3,3,999
  1018. DATA 255,3,3,3,3,255,48,48,48,48,999
  1019. DATA 15,15,15,240,240,240,999
  1020. DATA 31,31,31,0,0,241,241,241,0,0,999
  1021. DATA 252,252,252,252,3,3,999
  1022. DATA 126,66,90,90,66,126,129,999
  1023. DATA 5,10,5,10,175,95,175,95,999
  1024. DATA 28,34,65,73,65,34,28,0,999
  1025. DATA 1,130,68,40,16,40,68,130,999
  1026. DATA 3,6,12,24,255,24,12,6,3,255,999
  1027.  
  1028. ' PATTERNS 40-49
  1029. DATA 1,2,4,136,64,32,16,136,999
  1030. DATA 7,142,221,232,112,184,221,139,999
  1031. DATA 68,68,64,95,64,68,68,4,245,4,999
  1032. DATA 96,111,111,96,6,246,246,6,999
  1033. DATA 60,102,102,195,0,0,195,102,102,60,0,0,999
  1034. DATA 3,3,3,6,6,28,56,96,96,192,192,192,96,96,56,28,6,6,999
  1035. DATA 136,5,34,80,136,80,34,5,999
  1036. DATA 62,34,175,168,184,136,143,0,0,999
  1037. DATA 34,32,112,32,34,2,7,2,999
  1038. DATA 62,34,227,128,128,128,227,34,62,8,8,8,999
  1039.  
  1040. ' PATTERNS 50-59
  1041. DATA 156,54,99,54,156,201,999
  1042. DATA 1,3,7,15,31,63,127,255,999
  1043. DATA 60,153,153,195,0,0,195,153,153,60,0,0,999
  1044. DATA 31,16,16,16,241,1,1,1,999
  1045. DATA 221,68,119,17,999
  1046. DATA 255,128,159,144,144,144,999
  1047. DATA 255,255,1,253,253,5,245,245,21,213,213
  1048. DATA  84,84,87,80,80,95,64,64,127,0,0,999
  1049. DATA 128,128,142,136,136,139,8,8,232,136,136,184,999
  1050. DATA 254,128,190,130,186,162,170,170,42,171,40,235,8,239,0,999
  1051. DATA 0,127,1,125,5,117,21,85,0,247,4,245,5,117,69,85,999
  1052.  
  1053. ' PATTERNS 60-69
  1054. DATA 250,128,190,130,186,162,170,42,171,40,235,8,175,160,190,2,250
  1055. DATA  130,186,138,170,168,171,40,175,32,235,10,999
  1056. DATA 99,99,54,22,12,24,52,54,999
  1057. DATA 0,192,227,47,28,48,236,199,3,999
  1058. DATA 217,112,39,108,201,28,55,48,24,999
  1059. DATA 124,64,95,65,69,5,245,4,999
  1060. DATA 21,215,81,119,4,215,64,221,999
  1061. DATA 243,243,51,51,63,63,0,0,999
  1062. DATA 247,20,20,119,65,65,127,0,999
  1063. DATA 54,73,65,34,20,8,0,999
  1064. DATA 56,68,130,146,140,64,48,14,129,64,38,41,40,68,131,999
  1065.  
  1066. ' PATTERNS 70-79
  1067. DATA 8,8,20,34,193,34,20,8,999
  1068. DATA 20,34,73,85,148,34,34,65,73,65,34,34,148,85,73,34,999
  1069. DATA 6,9,9,6,0,96,144,144,96,0,999
  1070. DATA 119,5,119,80,999
  1071. DATA 8,28,42,65,227,65,42,28,8,8,8,999
  1072. DATA 8,42,34,34,54,20,213,20,54,34,34,42,8,999
  1073. DATA 0,62,8,162,85,170,85,162,8,62,999
  1074. DATA 255,85,170,85,170,85,255,8,8,8,8,999
  1075. DATA 32,38,25,1,16,145,98,2,999
  1076. DATA 146,41,68,999
  1077.  
  1078. ' PATTERNS 80-89
  1079. DATA 17,131,199,239,255,254,124,56,17,130,69,170,85,170,84,40,999
  1080. DATA 17,34,68,136,17,34,68,34,17,136,68,34,999
  1081. DATA 15,30,60,120,240,225,195,135,15,135,195,225,240,120,60,30,999
  1082. DATA 7,37,7,0,112,82,112,0,999
  1083. DATA 87,37,87,0,117,82,117,0,999
  1084. DATA 147,57,124,254,56,56,57,57,57,1,69,999
  1085. DATA 132,12,20,39,65,39,20,12,132,192,224,243,251,243,224,192,999
  1086. DATA 16,56,124,254,56,124,999
  1087. DATA 15,19,37,121,73,73,74,76,120,0,999
  1088. DATA 128,20,54,99,8,99,54,20,999
  1089.  
  1090. ' PATTERNS 90-99
  1091. DATA 32,32,32,0,0,7,0,0,999
  1092. DATA 102,0,153,0,102,0,85,0,170,0,85,0,999
  1093. DATA 136,0,34,0,102,0,153,0,999
  1094. DATA 255,1,1,1,1,13,13,1,999
  1095. DATA 8,20,42,85,170,85,42,20,8,28,62,127,255,127,62,28,999
  1096. DATA 85,42,20,8,20,42,999
  1097. DATA 21,10,228,241,241,228,10,999
  1098. DATA 125,17,215,16,215,17,125,1,999
  1099. DATA 109,9,107,72,91,66,218,18,214,144,182,132,181,36,173,33,999
  1100. DATA 78,72,72,78,74,74,78,66,66,78,74,74,999
  1101.  
  1102. DATA 7,9,19,33,121,65,127,0,0,124,68,84,68,92,80,112,0,0
  1103. DATA  124,68,92,80,112,0,0,124,68,84,68,124,0,0
  1104. DATA  124,68,84,68,116,20,28,0,0,112,80,92,68,84,84,124,0,0,0,999
  1105. DATA -1
  1106. END